home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0143_Cheap Cross-fading Routine.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  3KB  |  110 lines
  1. {
  2.  > Would anyone here know how to fade out/in only part of the screen? i.e.
  3.  > the left half of it or somethin?
  4. }
  5.  
  6. Program Cheap_Cross_Fading;
  7. Uses CRT;
  8.  
  9. {
  10.   Here's a cheap cross fading routine I did some time ago. I cleaned it up,
  11.   optimized a few parts, and made it look pretty. <g>.
  12.  
  13.   Use or abuse at will, just, as always, throw me a greet in your scrolltext
  14.   of doc files. Greet me as Dr. Nibble. Or if you dislike handles for some
  15.   anal reason, greet me as David Proper.
  16. }
  17.  
  18. Const
  19.  Bits : array[1..8] of byte = ($80,$40,$20,$10,$08,$04,$02,$01);
  20.  
  21.  MaxText = 6;
  22.  TextList : Array[1..MaxText] of String[30] = (
  23.             ' Dr. Nibble of',
  24.             '    Daemon',
  25.             '   presents',
  26.             '   a cheap',
  27.             ' crossfading',
  28.             '   routine');
  29.  
  30. var
  31.  Counter : integer;
  32.  CH      : char;
  33.  Loop    : integer;
  34.  Di     : byte;
  35.  
  36.  
  37. Procedure GTxT(Xp,Yp, Color : Integer; Line : String; Fseg,Fofs: word;
  38.                FYS : integer);
  39. Var
  40.  Loop  : Byte;
  41.  X     : Integer;
  42.  Y     : Integer;
  43.  
  44. begin
  45.  For Loop := 1 to Length(line) do
  46.   For Y := 1 to FYS do
  47.    For X := 1 to 8 do
  48.     {$R-}
  49.     If MEM[Fseg:Fofs+(Y-1)+ord(Line[Loop])*FYS] and bits[X] <> 0 then
  50.      if Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] = di then
  51.         Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] := 3 else
  52.         Mem[$A000:(Loop*9)+(X+Xp)+(320*(Y+Yp))] := Color
  53.     {$R+}
  54. end;
  55.  
  56.  
  57. Procedure SetColor(C,R,G,B : Byte);
  58.  Begin
  59.   Port[$3C8] := C; Port[$3C9] := R; Port[$3C9] := G; Port[$3C9] := B;
  60.  End;
  61.  
  62. Procedure VideoMode(Mode : Byte);
  63.  Begin
  64.   Asm
  65.    Mov  AH,00
  66.    Mov  AL,Mode
  67.    Int  10h
  68.   End;
  69.  End;
  70.  
  71.  
  72. BEGIN
  73.  VideoMode($13);
  74.  DI := 2;
  75.  Counter := 1;
  76.  
  77.  
  78. repeat
  79.  FillChar(mem[$A000:0],$ffff,#0);
  80.  SetColor(1,0,0,0); SetColor(2,1,0,0); SetColor(3,1,0,0);
  81.  DI := 2;
  82.  GTxT(90,90,1,TextList[Counter+1],$F000,$FA6E,8);
  83.  dec(di); if di = 0 then di := 2;
  84.  GTxT(90,90,2,TextList[Counter],$F000,$FA6E,8);
  85.  for loop := 1 to 63 do begin
  86.                          SetColor(2,loop,0,0);
  87.                          SetColor(3,loop,0,0);
  88.                          delay(20);
  89.                         end;
  90.  delay(400);
  91.  for loop := 1 to 63 do begin
  92.                          SetColor(1,loop,0,0);
  93.                          SetColor(2,63-loop,0,0);
  94.                          if loop < 32 then SetColor(3,63-loop,0,0)
  95.                                       else SetColor(3,loop,0,0);
  96.                          delay(20);
  97.                         end;
  98.  delay(400);
  99.  for loop := 1 to 63 do begin
  100.                          SetColor(1,63-loop,0,0);
  101.                          SetColor(3,63-loop,0,0);
  102.                          Delay(20);
  103.                         end;
  104.  inc(Counter,2); if counter > MaxText then counter := 1;
  105. until keypressed;
  106.  
  107.  ch := readkey;
  108.  VideoMode(3);
  109. END.
  110.